COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C*****  SUBRS NOTES, BMX, ACSHFT, TYPOUT  ***********
C00020 ENDMK
C⊗;
C*****  SUBRS NOTES, BMX, ACSHFT, TYPOUT  ***********

	SUBROUTINE NOTES
	COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
	1 /SCX/JALPHA(30),JX,RA,JZ,IRHY,RB,KA,KB,IZ
	1 /XRN/RN(1)
	1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG,
	1 IXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA /ALF/CLF,JQX,D,
	1 KQ,JG,X,ACC,STMDR,Y,LL,RZ,RC,INP(61) /POS/POS1,POS2,R4
	1 /FRMT/F78F(1),FA1(1),FA5(1),ASK
	1 /RINP/R(10,85),RPOS(2,50) /RMOD/RMODE2,SET4,IBEAM,
	1 NOSET,STEM,STUP,NTC,PS2,RAM,RDD,ITB,POSB
	DATA ACMV/2.3/
	RMODE=0
	IF(RMODE2.GE.500)RMODE=RMODE2
C  RMODE2≥500 IS FOR USER-ADDED NOTE AND REST ROUTINE (SUBR EXTRA)
CP	POS1=0
CP	POS2=200
	STFLG=0
	GO TO 111
444	FORMAT(' TYPE POS1, POS2, (SPC)  '$)
	SET4=RA
111	FORMAT(A2,F)
	CALL SETUP
	IF(STUP.GE.0)GO TO 8
CC	IF(ST(3601).GE.0)GO TO 8
C   ST(3601) IS LOC. OF RPOS(1,1)
C SKIPS IF USING SETUP ON SOME STAFF
	IF(POS2.NE.0)GO TO 4334
C JUMP IF POS1, POS2, ETC. WERE SET UP IN FILE (* SP  ST  POS1  POS2  X)
4333	TYPE 444
	ACCEPT F78F,POS1,POS2,R4
C  DON'T USE INVIS. RESTS WITH SPACING FEATURE!!!!
	REREAD 111,K,RA  
	IF(K.EQ.'SP')GO TO 444
C TYPE "SPn" TO SET SPACING STAFF AT THIS POINT.
	IF(POS2.EQ.0)POS2=200.
	IF(POS1.GE.POS2)GO TO 4333
C  TYPE ANY POSITIVE 3RD NUM. FOR PSUEDO-FIBONACCI SPACING OF RHYTH.
4334	STUP=STUP-R4
8	KN=0
	IRHY=0
C  IZ=# OF ITEMS FROM SCANR*******
	IZ=I-1
C  LIMIT OF 100 ITEMS***** 4/74 *****
	CLF=0
	KCLF=0
	JCLF=0
C  DEFAULT IS ALWAYS TREBLE CLEF

	IF(POS2.NE.0)GO TO 71
	POS2=200
71	K=IZ+1
	DO 70 KQ=1,IZ
	X=V(KQ)
	IF(X.GE.0)GO TO 70
	IF(-X.LT.2000)K=K-1
C TO GET THE RIGHT ITEM COUNT WITH CHORDS, ETC.
70	CONTINUE

	D=(POS2-POS1)/K
C   D WILL SPACE ALL ITEMS EVENLY FOR NOW

	STEM=-1
C   K=COUNTER FOR USEFUL ITEMS (OMITS CLEFS)
	K=1
	KQ=1
C   LOOPS TO 7333 
7	JG=-1
	X=V(KQ)
C notes =  1xyz.0   x=accidental, yz=note num.,  negative=chord note
C rest  =  2xyz.0   z=0=ordinary, =1=invis., =2=whole, =3=repeat bar
C                   =4=down, =5=up, -2xyz=num. of meas. rest
C clefs =  3xyz.0   z=0=treble, =1=bass, =2=alto, =3=tenor, neg.=invis.
C bars  =  4xyz.0   z=num. of staves up, neg.=dbl.bar
C ksig  = 17xyz.0   z=num. of accis.,  pos.=#, neg.=b
C meter = 18xyz.n   xy=top num, zn=bottom num	(DONE IN SCMSS)
C stem  =  5xyz.0   YZ=10=stem up,  =20=stem down
C staff =  5xyz.0   z=0=return to norm., =1=lower stf., =2=upper stf.

	IF(X)GO TO 27
C NEXT SORTS OUT ORDER OF CHORD
	RZ=V(KQ+1)
	IF(RZ.GT.0)GO TO 27
	IF(ABS(RZ).GE.2000)GO TO 27
C  SKIPS NON-NOTES  
327	RZ=AMOD(X,100.0)
57	LL=KQ
	Y=0
	RA=RZ
37	LL=LL+1
	STMDR=RA
	RA=-V(LL)
	IF(RA)GO TO 27
C  EXITS WITH NON-NOTES OR NON-CHORD NOTES.
	RA=AMOD(RA,100.0)
C  GETS RID OF ACCI. FOR NOW
	IF(RA.GE.99)GO TO 27
	IF(Y)127,97,67
C Y IS STEM DIRECTION.  -1=DOWN, 1=UP
97	Y=RA-STMDR
	GO TO 37
67	IF(RA.LT.RZ)V(LL)=V(LL)-7
C TRAP FOR NOTE IN WRONG OCT. (CONFUSES STEM DIRECTION.)
	IF(RA.GE.STMDR)GO TO 37
227	CALL EXCH(V(LL),V(LL-1))
C NOW START OVER AGAIN
	GO TO 57
127	IF(RA.GT.RZ)V(LL)=V(LL)+7
	IF(STMDR.GT.RA)GO TO 37
	GO TO 227
27	R4=0
	R5=0
	R6=0
	R8=0
	DO 89 LL=2,10
89	R(LL,K)=0
C   TO CLEAR END OF ITEM
	KODE=ABS(X)/1000
	IF(X.LT.0.AND.KODE.NE.2)GO TO 86
C  JUMP IF A CHORD NOTE, CLEF OR BAR OR METER
	IF(KODE.LE.2)IRHY=IRHY+1
C   ADDS A RHYTHMIC UNIT
C  TO CLEAR LAST PARAMS IN SOME ITEMS LATER
86	GO TO (21,22,23,24,25),KODE
	IF(KODE.EQ.17)GO TO 1700
C  NEXT IS FOR METERS
	L=(X-18000.)/10
	R5=L
C   GETS TOP NUM OF METER
	R6=AMOD(X,10.0)*10.0+.01
	GO TO 843

23  	CLF=ABS(X)-3000.
	JCLF=CLF
	IF(X)GO TO 871
C  IS THE CLEF INVISIBLE?
	R5=CLF
	IF(KCLF)R4=R4+100
C  MINI CLEF AFTER 1ST REGULAR SIZE.
	KCLF=-1
	GO TO 843

25	Y=X-5000
	IF(Y.LT.10)GO TO 250
C  NEXT FOR STEM UP, DOWN
C DOWN = 20 (5020), UP=10 (5010)
	STEM=Y
	GO TO 871
250	STFLG=Y
C  STAFF ABOVE=2, BELOW=1, RESET=0
	GO TO 871

24	R4=ABS(X)-4000
	CALL NOZERO(R4)
	IF(X)R4=R4+1500
C  NEG =DBL BAR.
	GO TO 843

1700	R5=ABS(X)-17000.
C KEY SIGS    NEG=FLATS
	IF(X)R5=-R5
	R6=CLF
	GO TO 843

22	Y=ABS(X)-2000
	IF(X)GO TO 831
	IF(Y.EQ.0)GO TO 843
C  ORDINARY REST=0
	IF(Y.LT.4)GO TO 882
C  REST UP=5, DOWN=4
	R4=6
	IF(Y.EQ.4)R4=-R4
	GO TO 843

882	IF(Y.EQ.1)GO TO 885
	IF(Y.EQ.2)GO TO 886
C NEXT FOR CENTERED REPEAT SIGN
	R8=-5
CQQ	R5=-4
	GO TO 843
CQQ	GO TO 887

885	R8=9999
C ↑↑ FOR INVIS. REST
	GO TO 843

886	R8=-1
C ↑ FOR WHOLE REST (ANY RHYTHM)
CC887	R(9,K)=-1
	GO TO 843

831	R8=Y
C  NUMS OF BARS REST
CQQ	GO TO 887
	GO TO 843

21	R(10,K)=STFLG
	IF(X.GT.0)GO TO 210
	X=-X
	R8=-1
C  CHORD NOTE
	JG=0 
210	LL=X-1000
C  NOTES
	L=LL/100
C  THE ACCI.
	R5=L
	N=MOD(LL,100)-1
C  THE NOTE NUM.
	L=N/7
C OCT. NUM HERE IS 1 .GT. THAN THAT TYPED.  (OCT. 0 IS POSSIBLE NOW.)
	N=MOD(N,7)+1
C  ABSOLUTE NOTE NUM.
	KA=JCLF*12
C  THIS WILL ADJUST FOR CLEF NUM.
	IF(JCLF.GE.2)KA=JCLF*2+2
	R4=(L-4)*7+KA+N
	STMDR=10.
	IF(R4.GE.7)STMDR=20.
CO	IF(STEM.GT.0)STMDR=STEM
	IF(STEM.LE.0)GO TO 26
	STMDR=STEM
C  SHORTEN STEMS WHEN TURNED TO NON-STANDARD DIRECTION.
CCC NO NO NO -- THIS USED ESLWHERE.	R8=-1
C  FOR STEM DIRECTIONS - 'B' AND HIGHER HAVE STEMS DOWN.
CO	IF(JG)GO TO 3133
C  JUMP IF NOT DBLSTOP
26	IF(JG.GE.0)GO TO 6
C  NEXT LENGTHENS STEMS FOR VERY HIGH OR VERY LOW NOTES.
	IF(STMDR.EQ.20)GO TO 16
C NEXT FOR STEM UP
	IF(R4.LT.0)R8=-R4
C  STEMS OF VERY HIGH OR VERY LOW NOTES WILL ALWAYS TOUCH MIDDLE LINE
	GO TO 3133
16	IF(R4.GT.14)R8=R4-14
C SEE 'BEAMS' AT 143 FOR SIMILAR FEATURE
	GO TO 3133
6	L=K-1
	IF(R(5,L).GE.10.)MX=L
C  MX=1ST NOTE OF CHRD
	STMDR=0
	L=K-MX
	IF(R4.LT.R(4,MX))L=-L
	R(7,MX)=L
C L+=STEM UP, L-=STEM DOWN ... USED AT END OF NOTES.
	X=ABS(R(4,MX)-R4)-1.
C  EXTENDS THE STEM!
C  AFTER 1ST NOTE, ORDER MAY BE SCRAMBLED IN CHORDS.  STEM OK.
	IF(X.LT.1.)X=1.
	IF(R(8,MX).LT.X)R(8,MX)=X
3133	R5=R5+STMDR

843	R(4,K)=R4
	R(5,K)=R5
	R(6,K)=R6
	R(8,K)=R8
CS	R(2,K)=STAFF
	IF(JG)KN=KN+1
	R(3,K)=KN*D+POS1
	R(1,K)=KODE
87	K=K+1
871	KQ=KQ+1
	IF(KQ.LE.IZ)GO TO 7

	IZ=K-1
C  IZ IS NOW REALLY THE NUMBER OF ITEMS TO BE PROCESSED
C  NEXT ADJUSTS PLACEMENT OF ACCIDENTALS AND 2NDS.
	K=1
1	RX=R(7,K)
	IF(RX.EQ.0)GO TO 2
	IF(R(1,K).EQ.2.)GO TO 2
C  JUMP IF NO CHRD COMING
	IF(RX.GT.0)GO TO 3
C  JUMP IF STEM IS UP
	RA=R(5,K)
	IF(RA.LT.10)GO TO 277
	IF(RA.LT.20.)R(5,K)=RA+10.
C  PUTS STEM DOWN IF IT WASN'T
277	L=K-RX
C  RX=TOTAL(-1) NOTES IN CHORD
	R(7,K)=0
4	RA=R(4,K)
	RC=0
C  INTERVAL TO PREVIOUS NOTE
C  CHECK ON USE OF N ELSEWHERE
	N=K+1
	IF(K.LT.L)RC=RA-R(4,N)
C  INTERVAL TO NEXT NOTE
	IF(RC+R(6,K).EQ.1.)R(6,N)=20
C  PUSHES NOTE TO LEFT 
5	K=N
	IF(K.GT.L)GO TO 220
	GO TO 4

3	DO 30 M=2,IZ
	L=M-1
	IF(R(4,M)-R(4,L)+R(6,L).NE.1.)GO TO 30
	IF(R(3,M).NE.R(3,L))GO TO 30
	R(6,M)=10
	R(6,L)=30
30	CONTINUE
C  TO HELP DOTTED NOTES.
C  MOVES NOTE TO RIGHT OF STEM WHEN 2ND.
C  THE STEM IS UP
	RA=R(5,K)
	IF(RA.GE.20.)R(5,K)=RA-10.
C  PUTS STEM UP IF IT WASN'T
	R(7,K)=0
	K=1+K+RX
220	CALL ACSHFT(RX)
C  L=K-1=END OF CHORD;  L-ABS(RX)=START OF CHORD; +RX=↑  -RX=↓
	GO TO 222

2	K=K+1
222	IF(K.LE.IZ)GO TO 1
	R(1,K)=0
	END

	SUBROUTINE BMX(RA)
C  RA=NUMB. OF TAILS
C  VQ HOLDS TEMPORARY INFO RE. MULTIPLE BEAMS.
	COMMON E,F,G,H,RJQ(34),RB,VQX,JB,B,JV,JW /XRN/RN(1)
	1 /RINP/R(10,85),VQ(100) /STF/RSTFAC(0/7),RSTJ2
	1 /SCM/V(78),I,LCNT,STAFF,LIST(200),REND
	1/LIMIT/LIMIT,ITEM,LL,IS,IX /SC/J,L,MK
	1 ,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG,IXX,ISEMI,IQT
	1 ,VX(50),IAMP,K,KN,M,MODE,IBLA
	1 /SCX/JALPHA(30),JX,U,JZ,IRHY,JD,KA,KB,IZ
	M=IS-12
	DO 1 L=KN,K
1	VQ(L)=AMOD(R(7,L),10.0)
	VQ(K+1)=0
C   CLEARS IT FOR ROUTINE AT '3'
	JB=KN

6	DIS=0
	RB9=0
	DO 2 L=JB,K
	IF(VQ(L).LE.RA)GO TO 2
C  SKIP IF EQ. TO PRESENT BEAM
	RB=VQ(L)
4	DO 11 JD=L,K
	VQX=VQ(JD)
	IF(VQX.GE.RB)GO TO 20
	IF(VQX.EQ.0)GO TO 11
C  VQX=0 ON NON-STEM NOTES OF CHORDS. (HENCE NO TAILS)
21	B=10.
	IF(L.GT.KN)GO TO 13
	GO TO 16
20	JV=JD
	IF(VQX.GT.RB)GO TO 21
11	JW=JD
	B=20
C  FINDS NEED FOR BEAM TO LEFT 
16	B=B+RA
	DO 5 JE=1,6
5	RN(JE+IS)=RN(JE+M)
	RN(7+IS)=RN(7+M)+RB-RA*2.
C  ADDS RIGHT NUM. OF BEAMS
	IF(L.NE.JV)GO TO 10
	IF(L.EQ.KN)GO TO 377
	IF(L.NE.K)GO TO 10
377	B=-B
C PARTIAL, UNATTACHED BEAM IS PLACED AUTOMATICALLY IN ITMSUB.
	GO TO 8
13	IF(JV.GT.L)GO TO 14
	IF(R(7,L+1).LT.10)GO TO 15
C NEXT FOR DOT ON FOLLOWING NOTE.
	DIS=10.
	GO TO 19
15	DIS=20.
C SHORT INNER BEAM TO LEFT OF STEM
19	B=-RA
	GO TO 16
14	DIS=30
C  LONG INNER BEAM
	JV=-JV
	GO TO 16

C  PARTIAL BEAM IS ON RIGHT(+) OR LEFT(-).  RBM IS LENGTH.
10	IF(L.EQ.KN)GO TO 22
	IF(JV.GE.0)GO TO 17
	B=R(3,L)
	JV=-JV
	L=JV
22	IF(VQ(JW+1).GT.VQ(JW))GO TO 17
	VQ(JW)=VQ(JW+1)
	JW=JW-1
17	IF(L.NE.JB)GO TO 18
	IF(B.LT.20.)L=JV
C PUTS BEAMS IN RIGHT PLACE.
18	RC=R(10,L)
	IF(RC.EQ.0)GO TO 23
	RB=2.44*RSTJ2
	IF(ABS(R(4,L)).GE.100)RB=RB*.6
C  GET WIDTH OF NOTE FOR DISPLACEMENT
CC18	RB9=R(3,L)
	IF(RC.EQ.2)RB=-RB
	RC=RB
CCC	B=B+RC
23	RB9=RC+R(3,L)
C  THIS WILL BE POS.3
	DIS=RA+DIS
C  DISPLACES
	GO TO 8
2	CONTINUE
	RETURN
8	JB=JW+1
C  FINDS SIDE (L,R) FOR PARTIAL BEAM
C  FOR NEW DISPLACEMENT
	RN(IS+11)=-1
	IF(RB9+DIS.EQ.0)GO TO 31
	IF(DIS.LT.10)GO TO 32
	IF(DIS.LT.30)GO TO 33
C INNER PARTIAL BEAM IS NEXT
	DIS=DIS-30
	GO TO 31
32	IF(B.GE.20)GO TO 12
	DIS=B-10
	B=-1
C  -1 PICKS UP POS OF P3
CC	B=RN(3+M)
	GO TO 31
12	DIS=B-20
	B=RB9
	RB9=-1
C  -1 IN P9 WILL PICK UP POS OF P6
CC	RB9=RN(6+M)
C  INNER BEAM ATTACHED TO LFT SIDE.
	GO TO 31
33	B=-DIS
	DIS=0
31	RN(8+IS)=B
	RN(9+IS)=RB9
	RN(10+IS)=DIS
	CALL UPDATE(9)
C  ADDED ANOTHER ITEM (PART. BEAM)
	IF(JB.LE.K)GO TO 6
	END

	SUBROUTINE ACSHFT(RX)
	COMMON /XRN/RN(1) /STF/RSTFAC(0/7),RSTJ2
	1 /SCM/V(78),I,LCNT,STAFF,LIST(200),REND
	1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA
	1,DBST,NFLG,IXX,ISEMI,IQT,F(50),IAMP,K,KN,M,MODE,IBLA
	1 /RINP/R(10,85),VQ(100)
	EQUIVALENCE (A,F(1)),(B,F(2)),(X,F(4)),
	1(Y,F(5)),(Z,F(6)),(JD,F(7)),(RN1,F(8)),(RH,F(9))
	Z=0
	L=K-1
	M=L-ABS(RX)
	JD=1
	RN1=99
	Y=-.23
	IF(RX.LT.0)GO TO 1
	L=M
	M=K-1
	JD=-1
1	DO 2 N=M,L,JD
C  DOES IT HAVE AN ACCID?
	IF(AMOD(R(5,N),10.).EQ.0)GO TO 2
	A=0
	B=0
	IF(N.LT.L)A=R(6,N+1)
	IF(N.GT.M)B=R(6,N-1)
	IF(RN1.NE.99)GO TO 3
C  IS THIS THE FIRST ACCID?
	RN1=R(4,N)
	GO TO 6
3	RH=R(4,N)
	IF(ABS(RH-RN1).LT.5)GO TO 4
	RN1=RH
	IF(Y.GT.0)Z=Z+.04
C STOPS OCT., ETC. ACCIS BEING MOVED TO LEFT.
	Y=-.23+Z
6	IF(A.EQ.20)GO TO 477
	IF(B.NE.20)GO TO 4
477	Y=Z
4	X=0
	IF(R(6,N).EQ.20)X=-.24
	IF(R(6,N).EQ.10)X=.24
	Y=Y+.23
	IF(X+Y.LT.1)GO TO 7
	RN1=RH
	Z=Z+.04
	Y=0
	IF(A.EQ.20)GO TO 677
	IF(B.NE.20)GO TO 577
677	Y=.23
C  SO Y DOESN'T GET >1.
577	Y=Y+Z
7	X=X+Y
	IF(ABS(X-.04).LT..01)X=0
	IF(X.GE.0)GO TO 5
	Y=.23+Z
	X=Z
5	R(5,N)=R(5,N)+X*RSTFAC(IFIX(STAFF))
C  SPACING OF ACCI. DEPENDS ON STAFF SIZE FACTOR AT THIS POINT
2	CONTINUE
	END

	SUBROUTINE TYPOUT
	COMMON /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG,
	1 IXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA /ALF/INP(72),ML
	DO 1 KK=72,1,-1
1	IF(INP(KK).NE.IBLA)GO TO 2
2	TYPE 3,MODE,(INP(J),J=1,KK)
3	FORMAT(I2,4X,72A1)
	END